home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / setmem.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  9KB  |  260 lines
  1. /* setmem.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal value[200000];
  12. } blank_;
  13.  
  14. #define blank_1 blank_
  15.  
  16. struct {
  17.     doublereal cpyknt;
  18.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  19.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  20.         nwd16;
  21. } memmgr_;
  22.  
  23. #define memmgr_1 memmgr_
  24.  
  25. /* Table of constant values */
  26.  
  27. static integer c__1 = 1;
  28. static integer c__6 = 6;
  29.  
  30. /*<       subroutine setmem(ipntr,ksize) >*/
  31. /* Subroutine */ int setmem_(ipntr, ksize)
  32. integer *ipntr, *ksize;
  33. {
  34.     /* Local variables */
  35.     extern integer locf_();
  36.     static integer nevn, icheck, ifamwa;
  37. #define cvalue ((complex *)&blank_1)
  38.     extern /* Subroutine */ int errmem_();
  39.     extern integer nxtmem_();
  40.     extern /* Subroutine */ int memory_();
  41.     extern integer nxtevn_();
  42.  
  43.     /* Parameter adjustments */
  44.     --ipntr;
  45.  
  46.     /* Function Body */
  47. /*<       implicit double precision (a-h,o-z) >*/
  48.  
  49. /*     this routine performs dynamic memory management.  it is used in */
  50. /*     spice2, and useable in any program. */
  51.  
  52. /*     memory is managed within an array selected by the calling program. 
  53. */
  54. /*     one may either dimension this array to the 'maxmem' size, or more 
  55. */
  56. /*     desirably, find the address of the first available word of memory 
  57. */
  58. /*     above your program, and dimension your array to '1'.  passing the 
  59. */
  60. /*     address of the first data word available permits the manager to */
  61. /*     use 'illegal' indices into the data area. */
  62.  
  63. /*     this routine must have access to an integer function called 'locf' 
  64. */
  65. /*    which returns the address of its argument.  addresses as used by 
  66. this*/
  67. /*     program refer to 'integer' addresses, not byte addresses. */
  68.  
  69. /* entry points: */
  70. /*      setmem - set initial memory */
  71. /*      getm4  - get block for table of integers */
  72. /*      getm8  - get block for table of floating point variables */
  73. /*      getm16 - get block for table of complex variables */
  74. /*      relmem - release part of block */
  75. /*      extmem - extend size of existing block */
  76. /*      sizmem - determine size of existing block */
  77. /*      clrmem - release block */
  78. /*      ptrmem - reset memory pointer */
  79. /*      crunch - force memory compaction */
  80. /*      avlm4  - amount of space available (integers) */
  81. /*      avlm8  - amount of space available (real) */
  82. /*      avlm16 - amount of space available (complex) */
  83.  
  84. /* calling sequences: */
  85. /*      call setmem(imem(1),maxmem) */
  86. /*      call setmem(imem(1),maxmem,kfamwa)  cdc machines running under */
  87. /*                                         calidoscope kfamwa is the 
  88. address*/
  89. /*                                          of the first available word */
  90.  
  91. /*      call getm4 (ipntr,blksiz)  where blksize is the number of entries 
  92. */
  93. /*      call getm8 (ipntr,blksiz) */
  94. /*      call getm16(ipntr,blksiz) */
  95. /*      call relmem(ipntr,relsiz) */
  96. /*     call extmem(ipntr,extsiz)  extsiz is the number of entries to be 
  97. added*/
  98. /*      call sizmem(ipntr,blksiz) */
  99. /*      call clrmem(ipntr) */
  100. /*      call ptrmem(ipntr1,ipntr2) */
  101. /*      call avlm4(ispace) */
  102. /*      call avlm8(ispace) */
  103. /*      call avlm16(ispace) */
  104. /*      call crunch */
  105. /*     call slpmem(ipntr,slpsiz)  express desire for *slpsiz* extra 
  106. entries*/
  107.  
  108.  
  109. /* general comments: */
  110. /*     for each block which is allocated, a multi-word entry is 
  111. maintained*/
  112. /* in a table kept in high memory, of the form */
  113.  
  114. /*        word      contents */
  115. /*        ----      -------- */
  116.  
  117. /*          1       index of imem(.) into origin of block */
  118. /*                    i.e. contents of pointer (used for error check) */
  119. /*          2       block size (in words) */
  120. /*          3       number of words in use */
  121. /*          4       address of variable containing block origin */
  122. /*          5       number of words used per table entry */
  123. /*          6       slop size (in words) */
  124.  
  125. /*     all allocated blocks are an 'even' (nxtevn) number of words in 
  126. length,*/
  127. /* where a 'word' is the storage unit required for an 'integer' variable. 
  128. */
  129. /*      since block repositioning may be necessary, the convention that */
  130.  
  131. /* only one variable contain a block origin should be observed. */
  132. /*      for *getmem*, *ipntr* is set such that *array(ipntr+1)* is the */
  133. /* first word of the allocated block.  'ipntr' is set to address the 
  134. first */
  135. /* entry of the table when used with the appropriate variable type, i.e., 
  136. */
  137. /* nodplc(ipntr+1), value(ipntr+1), or cvalue(ipntr+1). */
  138. /*     for *clrmem*, *ipntr* is set to 'invalid' to enable rapid 
  139. detection*/
  140. /* of an attempt to use a cleared block. */
  141. /*      if any fatal errors are found, a message is printed and a flag */
  142. /* set inhibiting further action until *setmem* is called.  (in this */
  143. /* context, insufficient memory is considered a fatal error.) */
  144. /*      throughout this routine, *ldval* always contains the subscript of 
  145. */
  146. /* the last addressable word of memory, *memavl* always contains the */
  147. /* number of available words of memory, *numblk* always contains the */
  148. /* number of allocated blocks, and istack(*loctab* +1) always contains */
  149. /* the first word of the block table. */
  150.  
  151. /* spice version 2g.6  sccsid=blank 3/15/83 */
  152. /*<       common /blank/ value(200000) >*/
  153. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  154. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  155. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  156. /*<      2   nwd8,nwd16 >*/
  157. /*<       dimension ipntr(1) >*/
  158.  
  159. /*<       logical memptr >*/
  160. /*<       complex cvalue(32) >*/
  161. /*<       equivalence (value(1),cvalue(1)) >*/
  162. /*<       external locf >*/
  163.  
  164. /* ...  approximate time required to copy *nwords* integer values */
  165.  
  166. /*  nxtevn rounds the number up to the next 'even' value.  the value */
  167. /*  used for this 'even' number is the smallest number into which one */
  168. /*  can divide nwd4,nwd8,and nwd16. */
  169.  
  170.  
  171. /*  nxtmem  returns next higher memory size */
  172.  
  173.  
  174.  
  175. /* ***  setmem - set initial memory */
  176.  
  177. /*<       nwd4=1 >*/
  178.     memmgr_1.nwd4 = 1;
  179. /*<       nwd8=locf(value(2))-locf(value(1)) >*/
  180.     memmgr_1.nwd8 = locf_(&blank_1.value[1]) - locf_(blank_1.value);
  181. /*<       nwd16=locf(cvalue(2))-locf(cvalue(1)) >*/
  182.     memmgr_1.nwd16 = locf_(&cvalue[1]) - locf_(cvalue);
  183. /*<       memerr=0 >*/
  184.     memmgr_1.memerr = 0;
  185. /*<       nevn=nxtevn(1) >*/
  186.     nevn = nxtevn_(&c__1);
  187. /*     check that nxtevn function returns a number divisible by */
  188. /*     nwd4, nwd8, nwd16; also check that the memory increment */
  189. /*     nxtmem(.) is an integer multiple of nxtevn(1) */
  190. /*<       icheck=mod(nevn,nwd4)+mod(nevn,nwd8)+mod(nevn,nwd16)+ >*/
  191. /*<      1  mod(nxtmem(1),nevn) >*/
  192.     icheck = nevn % memmgr_1.nwd4 + nevn % memmgr_1.nwd8 + nevn % 
  193.         memmgr_1.nwd16 + nxtmem_(&c__1) % nevn;
  194. /*<       if(icheck.eq.0) go to 2 >*/
  195.     if (icheck == 0) {
  196.     goto L2;
  197.     }
  198. /*<       memerr=1 >*/
  199.     memmgr_1.memerr = 1;
  200. /*<       call errmem(6,memerr,ipntr(1)) >*/
  201.     errmem_(&c__6, &memmgr_1.memerr, &ipntr[1]);
  202. /*<     2 cpyknt=0.0d0 >*/
  203. L2:
  204.     memmgr_1.cpyknt = 0.;
  205. /*<       ifamwa=locf(ipntr(1)) >*/
  206.     ifamwa = locf_(&ipntr[1]);
  207. /*<       maxmem=ksize >*/
  208.     memmgr_1.maxmem = *ksize;
  209. /*<       ntab=nxtevn(6) >*/
  210.     memmgr_1.ntab = nxtevn_(&c__6);
  211. /*... add 'lorg' to an address and you get the 'istack' index to that 
  212. word*/
  213. /*<       lorg=1-locf(istack(1)) >*/
  214.     memmgr_1.lorg = 1 - locf_(memmgr_1.istack);
  215. /*<       ifwa=ifamwa+lorg-1 >*/
  216.     memmgr_1.ifwa = ifamwa + memmgr_1.lorg - 1;
  217. /*<       nwoff=locf(ipntr(1))+lorg-1 >*/
  218.     memmgr_1.nwoff = locf_(&ipntr[1]) + memmgr_1.lorg - 1;
  219. /*<       icore=nxtmem(1) >*/
  220.     memmgr_1.icore = nxtmem_(&c__1);
  221. /* ... don't take chances, back off from 'end of memory' by nxtevn(1) */
  222. /*<       ldval=ifwa+nxtmem(1)-nxtevn(1) >*/
  223.     memmgr_1.ldval = memmgr_1.ifwa + nxtmem_(&c__1) - nxtevn_(&c__1);
  224. /*<       memavl=ldval-ntab-ifwa >*/
  225.     memmgr_1.memavl = memmgr_1.ldval - memmgr_1.ntab - memmgr_1.ifwa;
  226. /*<       maxcor=0 >*/
  227.     memmgr_1.maxcor = 0;
  228. /*<       maxuse=0 >*/
  229.     memmgr_1.maxuse = 0;
  230. /*<       call memory >*/
  231.     memory_();
  232. /*<       if(memerr.ne.0) call errmem(6,memerr,ipntr(1)) >*/
  233.     if (memmgr_1.memerr != 0) {
  234.     errmem_(&c__6, &memmgr_1.memerr, &ipntr[1]);
  235.     }
  236. /*<       numblk=1 >*/
  237.     memmgr_1.numblk = 1;
  238. /*<       loctab=ldval-ntab >*/
  239.     memmgr_1.loctab = memmgr_1.ldval - memmgr_1.ntab;
  240. /*<       istack(loctab+1)=0 >*/
  241.     memmgr_1.istack[memmgr_1.loctab] = 0;
  242. /*<       istack(loctab+2)=memavl >*/
  243.     memmgr_1.istack[memmgr_1.loctab + 1] = memmgr_1.memavl;
  244. /*<       istack(loctab+3)=0 >*/
  245.     memmgr_1.istack[memmgr_1.loctab + 2] = 0;
  246. /*<       istack(loctab+4)=-1 >*/
  247.     memmgr_1.istack[memmgr_1.loctab + 3] = -1;
  248. /*<       istack(loctab+5)=1 >*/
  249.     memmgr_1.istack[memmgr_1.loctab + 4] = 1;
  250. /*<       istack(loctab+6)=0 >*/
  251.     memmgr_1.istack[memmgr_1.loctab + 5] = 0;
  252. /*<       return >*/
  253.     return 0;
  254. /*<       end >*/
  255. } /* setmem_ */
  256.  
  257. #undef cvalue
  258.  
  259.  
  260.